home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / xwindows / devel / whatvga.pas < prev    next >
Pascal/Delphi Source File  |  1992-05-13  |  19KB  |  860 lines
  1.  
  2. uses dos,crt;
  3.  
  4. type
  5.   str10=string[10];
  6.  
  7.  
  8. const
  9.   mems:array[0..7] of string[5]=('64 K','128 K','192 K','256 K','512 K','768 K','1 M','2 M');
  10.   mmmask :array[0..7] of byte=(0,0,0,0,1,3,3,7);
  11.   mmbanks:array[0..7] of byte=(1,2,3,4,8,12,16,32);
  12.  
  13.   _64  =0;
  14.   _128 =1;
  15.   _192 =2;
  16.   _256 =3;
  17.   _512 =4;
  18.   _768 =5;
  19.   _1024=6;
  20.   _2048=7;
  21.  
  22.   hx:array[0..15] of char='0123456789ABCDEF';
  23.  
  24.  
  25. type
  26.   CHIPS=(__EGA,__VGA,__chips451,__chips452,__chips453,__paradise,__video7
  27.         ,__tseng3,__tseng4,__tridBR,__tridCS,__trid89,__everex,__ati1,__ati2
  28.         ,__genoa,__oak,__cirrus,__aheadA,__aheadB,__ncr,__yamaha,__poach
  29.         ,__vesa,__none);
  30.  
  31. var
  32.   rp:registers;
  33.   mm:byte;  {in 64k blocks}
  34.   name:string[40];
  35.   base,old,curbank,x:word;
  36.   CHIP:CHIPS;
  37.  
  38.   video:string[5];
  39.   _crt:string[20];
  40.   secondary:string[20];
  41.   extra:string[80];
  42.   bytes:longint;
  43.   ix17,lins,vseg,vgran:word;
  44.  
  45. function istr(w:word):str10;
  46. var s:str10;
  47. begin
  48.   str(w,s);
  49.   istr:=s;
  50. end;
  51.  
  52. procedure vio(ax:word);
  53. begin
  54.   rp.ax:=ax;
  55.   intr(16,rp);
  56. end;
  57.  
  58. function rdinx(pt,inx:word):word;       {read register PT index INX}
  59. begin
  60.   port[pt]:=inx;
  61.   rdinx:=port[pt+1];
  62. end;
  63.  
  64. procedure wrinx(pt,inx,val:word);       {write VAL to register PT index INX}
  65. begin
  66.   port[pt]  :=inx;
  67.   port[pt+1]:=val;
  68. end;
  69.  
  70. procedure modinx(pt,inx,mask,nwv:word);
  71. begin
  72.   port[pt]:=inx;
  73.   port[pt+1]:=(port[pt+1] and not mask)+(nwv and mask);
  74.  
  75. end;
  76.  
  77. procedure setchip23(bank:word);
  78. begin
  79.   if chip=__chips452 then bank:=bank shl 2 else bank:=bank shl 4;
  80.   wrinx(base+2,16,bank);
  81.  { wrinx(base+2,17,bank);}
  82. end;
  83.  
  84. procedure setbank(bank:word);
  85. var x:word;
  86. begin
  87.   vseg:=$a000;
  88.   if odd(port[$3cc]) then base:=$3d4 else base:=$3b4;
  89.   case chip of
  90.     __chips451:wrinx(base+2,11,bank);
  91.     __chips452:wrinx(base+2,16,bank shl 2);
  92.     __chips453:wrinx(base+2,16,bank shl 4);
  93.     __paradise:wrinx($3ce,9,bank shl 4);
  94.     __video7:begin
  95.                x:=port[$3cc] and $df;
  96.                if (bank and 2)>0 then inc(x,32);
  97.                port[$3c2]:=x;
  98.                modinx($3c4,$f9,1,bank);
  99.                modinx($3c4,$f6,$80,(bank shr 2)*5);
  100.  
  101.              end;
  102.     __tseng3:port[$3cd]:=bank*9+64;
  103.     __tseng4:port[$3cd]:=bank*17;
  104.     __tridBR:;
  105.     __tridCS,__poach,__trid89
  106.             :begin
  107.                wrinx($3c4,11,0);
  108.                if rdinx($3c4,11)=0 then;
  109.                modinx($3c4,14,$f,bank xor 2);
  110.              end;
  111.     __everex:begin
  112.                x:=port[$3cc] and $df;
  113.                if (bank and 2)>0 then inc(x,32);
  114.                port[$3c2]:=x;
  115.                modinx($3c4,8,$80,bank shl 7);
  116.              end;
  117.     __ati1:modinx($1ce,$b2,$1e,bank shl 1);
  118.     __ati2:modinx($1ce,$b2,$ee,bank*$22);
  119.     __genoa:wrinx($3c4,6,bank*9+64);
  120.     __oak:wrinx($3de,17,bank*17);
  121.     __aheadA:begin
  122.                wrinx($3ce,13,bank shr 1);
  123.                x:=port[$3cc] and $df;
  124.                if odd(bank) then inc(x,32);
  125.                port[$3c2]:=x;
  126.              end;
  127.     __aheadB:wrinx($3ce,13,bank*17);
  128.     __ncr:wrinx($3c4,$18,bank shl 2);
  129.     __vesa:begin
  130.              rp.bx:=0;
  131.              rp.dx:=bank*longint(64) div vgran;
  132.              vio($4f05);
  133.              rp.bx:=1;
  134.              vio($4f05);
  135.            end;
  136.   end;
  137.   curbank:=bank;
  138. end;
  139.  
  140. procedure setpix(x,y,col:word);
  141. var l:longint;
  142. begin
  143.   l:=y*bytes+x;
  144.   setbank(l shr 16);
  145.   mem[vseg:word(l)]:=col;
  146. end;
  147.  
  148. procedure setvesa(bx:word);
  149. var vesarec:array[0..255] of byte;
  150. begin
  151.   rp.bx:=bx;
  152.   vio($4f02);
  153.   rp.cx:=bx;
  154.   rp.es:=sseg;
  155.   rp.di:=ofs(vesarec);
  156.   vio($4f01);
  157.   vgran:=vesarec[4];
  158. end;
  159.  
  160. procedure setchip(mde:word);
  161. begin
  162.   vio(mde);
  163.   portw[$46e8]:=$1e;
  164.   portw[$103]:=$80;
  165.   portw[$46e8]:=$e;
  166.   modinx(base+2,4,4,4);
  167.   modinx(base+2,11,3,1);
  168. end;
  169.  
  170. procedure setev(mde:word);
  171. begin
  172.   rp.bl:=mde;
  173.   vio($70);
  174. end;
  175.  
  176. procedure setwd(mde:word);
  177. begin
  178.   vio(mde);
  179.   modinx($3ce,15,$17,5);
  180.   wrinx(base,$29,$85);
  181.   modinx(base,$2f,2,0);
  182. end;
  183.  
  184. procedure setvideo(mde:word);
  185. begin
  186.   rp.bl:=mde;
  187.   vio($6f05);
  188. end;
  189.  
  190.  
  191. procedure setmode0;        {Enter 320x200 mode}
  192. begin
  193.   bytes:=320;lins:=200;
  194.   case CHIP of
  195.     __chips451,__chips452,__chips453:setchip($13);
  196.     __paradise:setwd($13);
  197.   else vio($13);
  198.   end;
  199. end;
  200.  
  201. procedure setmode1;        {Enter 640x400 mode}
  202. begin
  203.   bytes:=640;lins:=400;
  204.   case CHIP of
  205.     __chips451,__chips452,__chips453:setchip($78);
  206.     __paradise:setwd($5e);
  207.     __video7:setvideo($66);
  208.     __tseng3:begin vio($2d);lins:=350 end;
  209.     __tseng4:vio($2f);
  210.     __tridBR,__tridCS,__poach,__trid89:vio($5c);
  211.     __everex:setev($14);
  212.     __ati1,__ati2:vio($61);
  213.     __genoa:vio($7e);
  214.     __oak:;
  215.     __cirrus:;
  216.     __aheadA,__aheadB:vio($60);
  217.     __ncr:;
  218.     __vesa:setvesa($100);
  219.   end;
  220. end;
  221.  
  222. procedure setmode2;     {Enter 640x480 mode}
  223. begin
  224.   bytes:=640;lins:=480;
  225.   case CHIP of
  226.     __chips451,__chips452,__chips453:setchip($79);
  227.     __paradise:setwd($5f);
  228.     __video7:setvideo($67);
  229.     __tseng3,__tseng4:vio($2e);
  230.     __tridBR,__tridCS,__poach,__trid89:vio($5d);
  231.     __everex:setev($30);
  232.     __ati1,__ati2:vio($62);
  233.     __genoa:vio($5c);
  234.     __oak:vio($53);
  235.     __cirrus:;
  236.     __aheadA,__aheadB:vio($61);
  237.     __ncr:;
  238.     __vesa:setvesa($101);
  239.   end;
  240. end;
  241.  
  242. procedure setmode3;     {Enter 800x600 mode}
  243. begin
  244.   bytes:=800;lins:=600;
  245.   case CHIP of
  246.     __chips451,__chips452,__chips453:setchip($7b);
  247.     __paradise:setwd($5c);
  248.     __video7:setvideo($69);
  249.     __tseng3,__tseng4:vio($30);
  250.     __tridBR:;
  251.     __tridCS,__poach,__trid89:vio($5e);
  252.     __everex:setev($31);
  253.     __ati1,__ati2:vio($63);
  254.     __genoa:vio($5e);
  255.     __oak:vio($54);
  256.     __cirrus:;
  257.     __aheadA,__aheadB:vio($61);
  258.     __ncr:;
  259.     __vesa:setvesa($101);
  260.   end;
  261. end;
  262.  
  263. procedure setmode4;        {Enter 1024x768 mode}
  264. begin
  265.   bytes:=1024;lins:=768;
  266.   case CHIP of
  267.     __tseng4:vio($38);
  268.     __tridCS,__trid89:vio($61);
  269.     __everex:setev($32);
  270.     __ati2:vio($61);
  271.     __aheadB:vio($63);
  272.     __vesa:setvesa($105);
  273.   end;
  274. end;
  275.  
  276. procedure setvstart(l:longint);       {Set the display start address}
  277. var x,y:word;
  278. begin
  279.   x:=l shr 2;
  280.   y:=(l shr 18) and mmmask[mm];
  281.   wrinx(base,13,lo(x));
  282.   wrinx(base,12,hi(x));
  283.   case chip of
  284.     __tseng3:modinx(base,$23,2,y shl 1);
  285.     __tseng4:modinx(base,$33,3,y);
  286.     __tridcs:modinx(base,$1e,32,y shl 5);
  287.     __trid89:begin
  288.                modinx(base,$1e,$a0,y shl 5+128);
  289.                wrinx($3c4,11,0);
  290.                modinx($3c4,$e,1,y shr 1);
  291.              end;
  292.     __video7:modinx($3c4,$f6,$70,(y shl 4) and $30);
  293.   __paradise:modinx($3ce,$d,$18,y shl 3);
  294.   __chips452,__chips453:
  295.              begin
  296.                wrinx($3d6,12,y);
  297.                modinx($3d6,4,4,4);
  298.              end;
  299.   __aheadb:modinx($3ce,$1c,3,y);
  300.  
  301.   end;
  302. end;
  303.  
  304. procedure wrtxt(x,y:word;txt:string);      {write TXT to pos (X,Y)}
  305. type
  306.   pchar=array[char] of array[0..15] of byte;
  307. var
  308.   p:^pchar;
  309.   c:char;
  310.   i,j,z,b:integer;
  311. begin
  312.   rp.bh:=6;
  313.   vio($1130);
  314.   p:=ptr(rp.es,rp.bp);
  315.   for z:=1 to length(txt) do
  316.   begin
  317.     c:=txt[z];
  318.     for j:=0 to 15 do
  319.     begin
  320.       b:=p^[c][j];
  321.       for i:=x+7 downto x do
  322.       begin
  323.         if odd(b) then setpix(i,y+j,15)
  324.                   else setpix(i,y+j,0);
  325.         b:=b shr 1;
  326.       end;
  327.     end;
  328.     inc(x,8);
  329.   end;
  330. end;
  331.  
  332. procedure testvmode;          {Test pattern}
  333. begin
  334.   for x:=50 to bytes-50 do
  335.   begin
  336.     setpix(x,30,lo(x));
  337.     setpix(x,lins-30,lo(x));
  338.   end;
  339.   for x:=30 to lins-30 do
  340.   begin
  341.     setpix(x+20,x,lo(x));
  342.     setpix(bytes-30-x,x,lo(x));
  343.     setpix(50,x,lo(x));
  344.     setpix(bytes-50,x,lo(x));
  345.   end;
  346.   wrtxt(70,70,name+' with '+mems[mm]+'bytes.');
  347.   wrtxt(70,100,'Mode: '+istr(bytes)+'x'+istr(lins)+' 256 color');
  348.   if readkey=' ' then;
  349.   textmode(3);
  350. end;
  351.  
  352.  
  353. function getbios(offs,lnn:word):string;
  354. var s:string;
  355. begin
  356.   s[0]:=chr(lnn);
  357.   move(mem[$c000:offs],s[1],lnn);
  358.   getbios:=s;
  359. end;
  360.  
  361. function tstrg(pt,msk:word):boolean;       {Returns true if the bits in MSK
  362.                                             of register PT are read/writ